Attribute VB_Name = "mdlPretzel"
Option Explicit

Public Type typePretzelState '128 bytes
 Value(127) As Byte '(15, 7)
 'bit 0-3 : 1-15=card
 'bit 4-7 : color 0-7
 '===
 '0-can't move placeholder
 '>=&H80 : can move placeholder
 'bit 0-3 : x
 'bit 4-7 : y+8
 '///TODO:current algorithm is slow. add reverse mapping
 Value2(127) As Byte
End Type

Public Type typePretzelStateInfo '16 bytes
 nHash As Long '0-&H7FFFFF
 idxNext As Long 'linked-list
 idxMovePrev As Long
 nReserved As Long
End Type

Private nEndStateHash As Long

'1-based
Private st() As typePretzelState, sti() As typePretzelStateInfo
Private stc As Long, stm As Long

Private sol() As Byte, solc As Long

Private idxHashFirst(&HFFFF&) As Long 'linked-list first item

Private nHashConst(127) As Long

Private n_K As Long, n_N As Long

Private Sub pConst()
Dim i As Long
Dim j As Long, k As Long
j = 241
k = 251
For i = 0 To 127 Step 2
 nHashConst(i) = j
 nHashConst(i + 1) = (k + 1) And &HFFFFF
 j = (j * 256& - j * 16& + j) And &HFFFFF
 k = (k * 256& - k * 4& - k) And &HFFFFF
Next i
For i = 0 To 127 Step 16
 nHashConst(i) = 0
Next i
End Sub

'Table[Mod[Prime[i]^j,4096],{i,40,70},{j,10}]
'173 1257    373 3089    1917    3961    1221    2337    2893    777
'179 3369    939 145 1379    1081    987 545 3347    1097
'181 4089    2829    49  677 3753    3453    2401    405 3673
'191 3713    575 3329    959 2945    1343    2561    1727    2177
'193 385 577 769 961 1153    1345    1537    1729    1921
'197 1945    2237    2417    1013    2953    109 993 3109    2169
'199 2737    3991    3681    3431    2833    2615    193 1543    3953
'211 3561    1803    3601    2051    2681    443 3361    563 9
'223 577 1695    1153    3167    1729    543 2305    2015    2881
'227 2377    3003    1745    2899    2713    1451    1697    195 3305
'229 3289    3613    4081    661 3913    3149    225 2373    2745
'233 1041    889 2337    3849    3889    921 1601    297 3665
'239 3873    4047    577 2735    2401    399 1153    1135    929
'241 737 1489    2497    3761    1185    2961    897 3185    1633
'251 1561    2691    3697    2251    3849    3539    3553    2971    249
'257 513 769 1025    1281    1537    1793    2049    2305    2561
'263 3633    1111    1377    1703    1425    2039    3777    2119    241
'269 2729    917 913 3933    1209    1637    2081    2733    1993
'271 3809    47  449 2895    2209    623 897 1423    609
'277 3001    3885    2993    1669    3561    3357    97  2293    281
'281 1137    9   2529    2041    81  2281    1985    729 49
'283 2265    2019    2033    1899    841 435 225 2235    1721
'293 3929    221 3313    4053    3785    3085    2785    901 1849
'307 41  299 1681    4067    3385    2907    3617    403 841
'311 2513    3303    3233    1943    2161    327 3393    2551    2833
'313 3761    1641    1633    3225    1809    969 193 3065    881
'317 2185    421 2385    2381    1113    565 2977    1629    297
'331 3065    2803    2097    1883    681 131 2401    107 2649
'337 2977    3825    2881    145 3809    1585    1665    4049    545
'347 1625    2723    2801    1195    969 371 1761    763 2617
'349 3017    261 977 1005    2585    1045    161 2941    2409

'linear hash :-3
Private Function pHash(t As typePretzelState) As Long
Dim i As Long, j As Long, k As Long
Dim n As Long
For j = 0 To n_K - 1
 k = j * 16&
 For i = 1 To n_N
  k = k + 1
  n = (n + t.Value(k) * nHashConst(k)) And &H7FFFFF
 Next i
Next j
pHash = n
End Function

Public Sub PretzelSetSize(ByVal n As Long, ByVal k As Long)
If n_N <> n Or n_K <> k Then
 n_N = n
 n_K = k
 nEndStateHash = 0
End If
stc = 0
Erase idxHashFirst
End Sub

Public Sub PretzelClear()
n_N = 0
n_K = 0
Erase st, sti, idxHashFirst
stc = 0
stm = 0
nEndStateHash = 0
End Sub

'&H80000000=win
'0=already exist
'>0=index
Private Function pFindAndAddItem(t As typePretzelState, Optional ByVal nHash As Long = -1) As Long
Dim b As Boolean
Dim i As Long, j As Long, k As Long, lp As Long
If nHash < 0 Then nHash = pHash(t)
If nHash = nEndStateHash Then
 b = True
 For j = 0 To n_K - 1
  lp = j * 16&
  For i = 0 To n_N - 1
   If t.Value(lp) <> lp + 1 Then
    b = False
    Exit For
   End If
   lp = lp + 1
  Next i
  If Not b Then Exit For
 Next j
 If b Then
  pFindAndAddItem = &H80000000
  Exit Function
 End If
End If
lp = idxHashFirst(nHash And &HFFFF&)
Do Until lp = 0
 If nHash = sti(lp).nHash Then
  b = True
  For j = 0 To n_K - 1
   k = j * 16&
   For i = 0 To n_N
    If t.Value(k) <> st(lp).Value(k) Then
     b = False
     Exit For
    End If
    k = k + 1
   Next i
   If Not b Then Exit For
  Next j
  If b Then Exit Function
 End If
 lp = sti(lp).idxNext
Loop
'add item
stc = stc + 1
If stc > stm Then
 stm = stm + 4096&
 ReDim Preserve st(1 To stm)
 ReDim Preserve sti(1 To stm)
End If
lp = idxHashFirst(nHash And &HFFFF&)
idxHashFirst(nHash And &HFFFF&) = stc
st(stc) = t
With sti(stc)
 .nHash = nHash
 .idxNext = lp
End With
pFindAndAddItem = stc
End Function

Public Function PretzelGetSolution(ByVal i As Long) As Long
If i > 0 And i <= solc Then
 PretzelGetSolution = sol(solc - i)
Else
 PretzelGetSolution = -1
End If
End Function

'TODO:return solution etc.
Public Function PretzelCalc(t As typePretzelState) As Boolean
Dim i As Long, j As Long, k As Long
Dim ii As Long, jj As Long, kk As Long
Dim a As Long, nHash As Long
Dim t2 As typePretzelState, tt As typePretzelState
stc = 0
solc = 0
Erase idxHashFirst, sol
'init table
If nHashConst(1) = 0 Then pConst
'init end state
If nEndStateHash = 0 Then
 For j = 0 To n_K - 1
  k = j * 16&
  For i = 0 To n_N - 1
   tt.Value(k) = k + 1
   k = k + 1
  Next i
 Next j
 nEndStateHash = pHash(tt)
End If
'normalize state
For j = 0 To n_K - 1
 kk = j * 16&
 t.Value2(kk + 1) = kk
 For i = 1 To n_N
  kk = kk + 1
  If (t.Value(kk) And &HF&) = 0 Then
   k = t.Value(kk - 1)
   If k > 0 And k < &H80& And (k And &HF&) < n_N Then
    k = k + 1
    For jj = 0 To n_K - 1
     For ii = 0 To n_N
      If t.Value(ii + jj * 16&) = k Then
       t.Value(kk) = ii + jj * 16& + &H80&
       k = 0
       Exit For
      End If
     Next ii
     If k = 0 Then Exit For
    Next jj
   Else
    t.Value(kk) = 0
   End If
   t.Value2(a) = kk
   a = a + 16&
  Else
   t.Value2(t.Value(kk)) = kk
  End If
 Next i
Next j
'start calc
If pFindAndAddItem(t) = &H80000000 Then
 PretzelCalc = True
 Exit Function
End If
'////////
k = 1
Do Until k > stc
 tt = st(k)
 nHash = sti(k).nHash
 For j = 0 To (n_K - 1) * 16& Step 16& 'for each placeholder
   i = tt.Value2(j) 'placeholder pos
   a = tt.Value(i)
   If a >= &H80& Then 'can move
    t2 = tt
    a = a And &H7F& 'movable card pos
    'update 1 and swap value2
    kk = t2.Value(a) 'movable card value
    t2.Value(i) = kk
    t2.Value2(j) = a
    t2.Value2(kk) = i
    ii = (nHash + (kk - a - &H80&) * nHashConst(i)) And &H7FFFFF 'update hash
    'update 1-right
    If (i And &HF&) < n_N Then
     If t2.Value(i + 1) = 0 And (kk And &HF&) < n_N Then
      jj = t2.Value2(kk + 1) + &H80&
      t2.Value(i + 1) = jj
      ii = (ii + jj * nHashConst(i + 1)) And &H7FFFFF 'update hash
     End If
    End If
    'update 2
    jj = t2.Value(a - 1)
    If jj > 0 And jj < &H80& And (jj And &HF&) < n_N Then
     jj = t2.Value2(jj + 1) + &H80&
    Else
     jj = 0
    End If
    t2.Value(a) = jj
    ii = (ii + (jj - kk) * nHashConst(a)) And &H7FFFFF 'update hash
    'update 2-right
    If (a And &HF&) < n_N Then
     jj = t2.Value(a + 1)
     If jj >= &H80& Then
      t2.Value(a + 1) = 0
      ii = (ii - jj * nHashConst(a + 1)) And &H7FFFFF 'update hash
     End If
    End If
    'add node
    kk = pFindAndAddItem(t2, ii)
    If kk = &H80000000 Then
     '////////debug
'     Dim s As String
'     s = "Nodes=" + CStr(stc) + vbCrLf
'     s = s + "Trace=(" + CStr(i?? + 1) + "," + CStr(j + 1) + ")"
     solc = 1
     ReDim sol(0)
     sol(0) = i
     kk = k
     Do
      jj = sti(kk).idxMovePrev
      If jj = 0 Then Exit Do
      ReDim Preserve sol(solc)
      sol(solc) = sti(kk).nReserved
      solc = solc + 1
'      ii = sti(kk).nReserved
'      s = s + "(" + CStr((ii And &HF&) + 1) + "," + CStr((ii And &HF0&) \ &H10& + 1) + ")"
      kk = jj
     Loop
'     'debug
'     Open CStr(App.Path) + "\solution.txt" For Output As #1
'     Print #1, s
'     Close
     '////////
     PretzelCalc = True
     Exit Function
    ElseIf kk > 0 Then 'record
     sti(kk).idxMovePrev = k
     sti(kk).nReserved = i
    End If
   End If
 Next j
 k = k + 1
Loop
'////////
'Open CStr(App.Path) + "\nodes.csv" For Output As #1
'For i = 1 To stc
' Print #1, sti(i).nHash
'Next i
'Close
End Function

